perm filename TICTAC.LSP[206,JMC]1 blob
sn#070525 filedate 1973-11-11 generic text, type T, neo UTF8
00100 (SETQ TICTACFNS @(
00200 TER
00300 IMVAL
00400 SUCCESSORS
00500 REVERT
00600 UPDATE
00700 DELETE
00800 CONTAINED
00900 PTS
01000 LINES
01100 ))
01200
01300 (SETQ PTS @((1 4 7) (1 5) (1 6 10) (2 4) (2 5 7 10) (2 6)
01400 (3 4 10) (3 5) (3 6 7)))
01500
01600 (SETQ LINES @((1 2 3) (4 5 6)(7 10 11) (1 4 7) (2 5 10)
01700 (3 5 11) (1 5 11) (3 5 7)))
01800
01900 (DE TER (P ALPHA BETA) (OR (EQUAL (LENGTH P) 11)
02000 (ORLIS (FUNCTION (LAMBDA (X) (CONTAINED X (COND
02100 (W XS)(T OS))))) (CAR (NTH LINES (CAR P))))))
02200
02300 (DE IMVAL (P ALPHA BETA) (COND ((ORLIS (FUNCTION
02400 (LAMBDA (X) (CONTAINED X (COND (W XS) (T OS)))))
02500 (CAR (NTH LINES (CAR P)))) (COND ((W 1) (T -1)))
02600 (T 0)))
02700
02800 (DE SUCCESSORS (P) (MAPCAR (FUNCTION (LAMBDA (X)
02900 (CONS X P))) BS))
03000
03100 (DE REVERT () (PROG NIL
03200 (SETQ BS (CONS (CAR (COND (W XS) (T OS))) BS))
03300 (COND (W (SETQ XS (CDR XS))) (T (SETQ OS (CDR OS))))
03400 (SETQ W (NOT W))
03500 (RETURN NIL)
03600 ))
03700
03800 (DE UPDATE (M) (PROG NIL
03900 (COND (W (SETQ OS (CONS (CAR M) OS))) (T (SETQ XS (CONS (CAR M) XS))))
04000 (SETQ BS (DELETE (CAR M) BS)
04100 (SETQ W (NOT W))
04200 (RETURN NIL)
04300 ))
04400
04500 (DE DELETE (X U) (COND ((NULL U) NIL) ((EQUAL X (CAR U)) (CDR U))
04600 (T (CONS (CAR U) (DELETE X (CDR U))))))
04700
04800 (DE CONTAINED (U V) (ANDLIS (FUNCTION (LAMBDA (X) (MEMBER X V))) U))